#!/usr/bin/perl
#
# Check f_ctime consistency across a file.
#
use strict;

use vars qw($DEBUG $filename $reccount $file $table @recs);
use vars qw($rec $savedctime $savedrec $savedcstamp %missing %toolate %tooearly);
use vars qw( $normjump $tolerance $test);
# counters
use vars qw($missing $suspicious $missingbeforefirstdate $tooearly);
use vars qw($intolerant $maxtol $minnorm);

use FileTable;
use HTTP::Date;
use Fcntl;
use Getopt::Long;

$DEBUG = 1;

$reccount = 1000000;
$test = 0;

GetOptions("debug" => \$DEBUG,
	   "test" => \$test,
	   "count=i" => \$reccount,
	   );

$filename = shift;

# Arbitrarily start the normal jump between records at 1 hours
# (this fits with the 10% testset)
$normjump = 1*3600; # in seconds
$minnorm = 1*3600; # never below 1 hour
# Tolerate jumps up to this number of normal jumps
$tolerance = 15;

if (! -f "$filename.conf") {
    $filename = $ENV{"COUNTER_ROOT"} . "/db/" . $filename;
}

$file = FileTable::open($filename, O_RDWR);
$table = $file->{_TABLE}; # grumble
@recs = $file->selectany("f_key, f_ctime from $table
			 order by f_key desc limit $reccount");

warn "Number of records is ", @recs + 0, "\n";
$missing = 0;
$suspicious = 0;
print "First key: ", ${$recs[0]}{f_key}, "\n";
print "Last key: ", ${$recs[$#recs]}{f_key}, "\n";

for $rec (@recs) {
    my $cstamp = str2time($$rec{f_ctime});
    if (!defined($$rec{f_ctime}) || $$rec{f_ctime} eq "0000-00-00 00:00:00") {
	# if the first is missing, we can do little
	if (!$savedctime) {
	    ++ $missingbeforefirstdate;
	    next;
	}
	$missing{$$rec{f_key}} = $savedctime;
        $DEBUG && warn "$$rec{f_key}: missing, cand $savedctime\n";
	++ $missing;
    } elsif ($savedctime && ($$rec{f_ctime} gt $savedctime)) {
        $toolate{$$rec{f_key}} = $savedrec;
	#$DEBUG && warn "$$rec{f_key}: $savedctime($savedrec) before $$rec{f_ctime}\n";
	++ $suspicious;
        # Compensate for the stretches of records w/o sensible f_ctime
        $savedcstamp -= $normjump;
    } elsif ($savedcstamp && $savedcstamp >
           $cstamp + $normjump*$tolerance*($intolerant+1)) {
        # Record is too old to make sense - either a serious downtime
        # or a misdated record
        $DEBUG && warn "$$rec{f_key}: Jump from $savedrec is ",
           ($savedcstamp - $cstamp) / 3600,
    " hours, tolerance ", $normjump*$tolerance*($intolerant+1)/3600, "\n";
        $tooearly{$$rec{f_key}} = 1;
	++ $tooearly;
        ++ $intolerant;
        # Compensate for the stretches of records w/o sensible f_ctime
        $savedcstamp -= $normjump;
        die "This does not make sense!\n" if $intolerant > 20;
    } else {
        $intolerant = 0;
    	$savedctime = $$rec{f_ctime};
	$savedrec = $$rec{f_key};
        if ($savedcstamp && $savedcstamp > $cstamp) {
	    $normjump = 0.02*($savedcstamp - $cstamp) + 0.98*$normjump;
	    $normjump = $minnorm if $normjump < $minnorm;
        }
        my $delta = $savedcstamp - $cstamp;
        if ($delta / $normjump > $maxtol) {
	    $maxtol = $delta / $normjump;
        }
	$savedcstamp = $cstamp;
    }
}
warn "$missing missing, $suspicious suspicious\n";
warn "$missingbeforefirstdate missing before anyone with date\n"
    if $missingbeforefirstdate;
warn "$tooearly jumps beyond tolerance\n";
warn "Decayed normjump is ", $normjump / 3600, " hours\n";
warn "Max tolerance used is ", $maxtol, "\n";
if ($missing > 0) {
    warn "Setting missing ones to same as the one later\n";
    my $key;
    for $key (keys(%missing)) {
        my $rec = $file->get($key);
	if (!$rec) { die "Record gone: $$key" }
	$rec->{f_ctime} = $missing{$key};
	bless $rec, "FileTable::Record";
        $rec->patch() if !$test;
    }
}

if ($suspicious > 0) {
    # Backdate the ones that have dates that don't fit in the sequence
    # Note: this isn't really right for people who register machines first
    # and then register themselves....but have to lose a few...

    my $key;
    for $key (sort(keys(%toolate))) {
    my $rec = $file->get($key);
       my $laterrec = $file->get($toolate{$key});
       die "No date in $toolate{$key}\n" if !$laterrec->{f_ctime};
       $rec->{f_ctime} = HTTP::Date::time2iso(
		    str2time($laterrec->{f_ctime}) - 1);
	bless $rec, "FileTable::Record";
       $DEBUG && warn "Patching $key to $$rec{f_ctime}\n";
       $rec->patch() if !$test;
    }
}

#------- We now have a consistent set, except for a few that are
#        suspected of being too early (intolerant jumps). Let's check those.

my $key;
for $key (sort(keys(%tooearly))) {
    my @prev = $file->select("f_key < ? order by f_key desc limit 1", $key);
    my $rec = $file->get($key);
    if ($prev[0]->{f_ctime} > $rec->{f_ctime}) {
       $rec->{f_ctime} = HTTP::Date::time2iso(
		    str2time($prev[0]->{f_ctime}) + 1);
       $DEBUG && warn "Patching $key to $$rec{f_ctime}\n";
	bless $rec, "FileTable::Record";
        $rec->patch() if !$test;
    } else {
        $DEBUG && warn "No reason to patch rec $key\n";
    }
}
        

